home *** CD-ROM | disk | FTP | other *** search
/ Garbo / Garbo.cdr / mac / hypercrd / xcmd / sprtxtrn.sea / Support Tools eXternals 1.2.5 / card_12440.txt < prev    next >
Text File  |  1990-11-13  |  9KB  |  300 lines
  1. -- card: 12440 from stack: in.5
  2. -- bmap block id: 12671
  3. -- flags: 0000
  4. -- background id: 3858
  5. -- name: DiskIsRemovable
  6. ----- HyperTalk script -----
  7. on hideObjects
  8.   hide cd btn "Try It!"
  9. end hideObjects
  10.  
  11. on showObjects
  12.   show cd btn "Try It!"
  13. end showObjects
  14.  
  15.  
  16. -- part 1 (button)
  17. -- low flags: 00
  18. -- high flags: A002
  19. -- rect: left=82 top=185 right=219 bottom=175
  20. -- title width / last selected line: 0
  21. -- icon id / first selected line: 0 / 0
  22. -- text alignment: 1
  23. -- font id: 0
  24. -- text size: 12
  25. -- style flags: 8192
  26. -- line height: 16
  27. -- part name: Try it!
  28. ----- HyperTalk script -----
  29. on mouseUp
  30.   global errGlobal
  31.   put VolumePath() into diskToCheck
  32.   if diskToCheck = "" then exit mouseUp
  33.   put DiskIsRemovable(diskToCheck,"noDialog:errGlobal") into remvState
  34.   if errGlobal Γëá empty then
  35.     answer "Error:" && errGlobal
  36.     put empty into errGlobal
  37.   else
  38.     if remvState = "True" then put "is" into verb
  39.     else put "is not" into verb
  40.     answer "The disk ΓÇ£" & diskToCheck & "ΓÇ¥" && verb && "removable."
  41.   end if
  42. end mouseUp
  43.  
  44.  
  45.  
  46. -- part contents for background part 38
  47. ----- text -----
  48. 9/50
  49.  
  50. -- part contents for background part 20
  51. ----- text -----
  52.      An XFCN which reports whether or not the specified volume is removable.
  53.  
  54.      Calling syntax :  DiskIsRemovable(diskname, <"noDialog:"errorGlobal>)
  55.  
  56.  
  57.  
  58.  
  59. -- part contents for background part 42
  60. ----- text -----
  61. { DiskIsRemovable(VolName ┬½,ΓÇ£noDialog:ΓÇ¥errorGlobal┬╗)}
  62. { XCMD to test for a removable disk}
  63. {}
  64. {   brought to you by:    Anup Murarka           Eric Carlson          }
  65. {                       ALINK:  SKEPTIC           ALINK:  cyNic   }
  66. {                                   CIS:  76004,3356        }
  67. {}
  68. {               We are part of the Support Tools Development Group,    }
  69. {               Apple Computer, Inc.     }
  70. {}
  71. {               please DO NOT contack Mac DTS for support of this code!   }
  72. {}
  73. {               please DO contact the authors for support of this code!  }
  74. {}
  75. {               Send comments, bug reports, requests to any of the above    }
  76. {               E-mail addresses or to:}
  77. {}
  78. {                           (one of us)                    }
  79. {                           Apple Computer, Inc.         }
  80. {                           900 E. Hamilton, Ave.       }
  81. {                           Campbell, CA   95008       }
  82. {                           M/S 72-L                     }
  83. {}
  84. {   Copyright:    ┬⌐ 1989, 1990 by Apple Computer, Inc., all rights reserved.     }
  85. {}
  86. { written by Eric Carlson                                      }
  87. { AppleLink:  cyNic                                                }
  88. { modification history                                           }
  89. {          Date              Initials                                      Comments                                 }
  90. {          ----              ------  ------------------------------------------------------  }
  91. {       1/20/90          ec             first written                                                                 }
  92. {       4/3/90            ec             fixed bug for partitioned disks returning $48                         }
  93. {       6/2/90            ec             commented code further                                                }
  94. {}
  95. {}
  96.  
  97. unit DiskIsRemovable;
  98.  
  99. interface
  100.  
  101.  uses
  102.   HyperXCmd;
  103.  
  104.  procedure MAIN (paramPtr: XCmdPtr);
  105.  
  106. implementation
  107.  
  108.  procedure reportToUser (paramPtr: XCmdPtr;
  109.        msgStr: str255);
  110. {}
  111. { report something back to the user.  }
  112. { the last parameter (optional) to an external may contain }
  113.  { "noDialog" or "noDialog:GlobalName".  GlobalName is the name }
  114.  { of a HyperTalk global variable into which error messages will be }
  115.  { placed.  we've decided to use this approach to avoid confusing }
  116. { an error message with a valid result being returned from an XFCN. }
  117. {}
  118.   var
  119.    tempStr: str255;
  120.  begin
  121. {check the last param to see if the user requested that}
  122. { we suppress the error dialog }
  123.   ZeroToPas(paramPtr, paramPtr^.params[paramPtr^.paramCount]^, tempStr);
  124.   UprString(tempStr, true);
  125.   if pos('NODIALOG', tempStr) = 0 then
  126. { no special error handling specified, throw up a dialog and return the error message }
  127.    begin
  128.     SendCardMessage(paramPtr, concat('answer "', msgStr, '"'));
  129.     paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
  130.    end
  131.   else if (pos(':', tempStr) > 0) then
  132. { requested global AND noDialog so we fill in the global and return empty }
  133.    begin
  134.     tempStr := copy(tempStr, pos(':', tempStr) + 1, length(tempStr));
  135. { get the name of the HC global  to fill }
  136.     SetGlobal(paramPtr, tempStr, PasToZero(paramPtr, msgStr));
  137. { and fill it }
  138.     paramPtr^.returnValue := PasToZero(paramPtr, '');{ return empty }
  139.    end
  140.   else
  141. { requested noDialog only so we return the error condition as the result }
  142.    paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
  143.  end;{ procedure }
  144.  
  145.  function AskedForHelp (paramPtr: XCmdPtr;
  146.        syntaxMsg: Str255;
  147.        copyrightMsg: Str255): boolean;
  148. {check to see if the user sent a '?' or a '!' as }
  149. { the only parameter. if so we will respond with }
  150. { the calling syntax or the copyright/version info }
  151. { for this external }
  152. {}
  153.   var
  154.    firstStr: str255;
  155.  begin
  156.   askedForHelp := false;
  157.   if paramPtr^.paramCount = 1 then
  158.    begin
  159.     ZeroToPas(paramPtr, paramPtr^.params[1]^, firstStr);
  160. { what is the first param? }
  161.     if firstStr = '?' then
  162.      begin
  163.       reportToUser(paramPtr, syntaxMsg);
  164.       askedForHelp := true
  165.      end{ asked for help }
  166.     else if firstStr = '!' then
  167.      begin
  168.       reportToUser(paramPtr, copyRightMsg);
  169.       askedForHelp := true
  170.      end;{ asked for copyright info }
  171.    end;{ one parameter passed }
  172.  end;{ function }
  173.  
  174.  function NumberToString (paramPtr: XCmdPtr;
  175.        num: LONGINT): Str255;
  176. { use the toolbox call rather than HC's }
  177.   var
  178.    tempStr: str255;
  179.  begin
  180.   NumToString(num, tempStr);
  181.   NumberToString := tempStr;
  182.  end;
  183.  
  184.  procedure ReportVolError (paramPtr: XCmdPtr;
  185.        errorNum: integer);
  186.   var
  187.    errMsg, tempName: str255;
  188.  begin
  189.   sysbeep(40);
  190.   case errorNum of{ what caused the problem? }
  191.    bdNamErr: 
  192.     errMsg := 'Bad volume name.';
  193.    extFSErr: 
  194.     errMsg := 'External file system.';
  195.    ioErr: 
  196.     errMsg := 'I/O Error.';
  197.    nsDrvErr: 
  198.     errMsg := 'No such drive.';
  199.    nsvErr: 
  200.     errMsg := 'No such volume.';
  201.    paramErr: 
  202.     errMsg := 'No default volume.';
  203.    otherwise
  204.     errMsg := concat('unexpected error #', NumberToString(paramPtr, errorNum));
  205.   end;{ case }
  206.  
  207.   errMsg := concat('Sorry, ', errMsg);
  208.   reportToUser(paramPtr, errMsg);
  209. { return the error message }
  210.  end;{ function }
  211.  
  212.  function DriveRemovable (aDQEPtr: DrvQElPtr): boolean;
  213. { the long  proceeding each element in the drive que contains a flag in }
  214. { byte  1 which = 0 if no disk is in the drive, 1 or 2 if a disk is in the }
  215. { drive, and 8 if a non removable disk is in the drive, or $48 if the }
  216. { disk is non removable but the 'driver wants a call' (IM IV-181)   }
  217. { 11:42 AM 1/10/90 ec }
  218.   var
  219.    flagsPtr: ^longint;
  220.    tempLong: longint;
  221.  begin
  222.         {subtract 4 from the DrvQE1Ptr to grab the long there }
  223.   flagsPtr := pointer(ord4(aDQEPtr) - 4);
  224.   tempLong := BAND(BSR(flagsPtr^, 16), $FF);
  225.   DriveRemovable := (tempLong <> 8) and (tempLong <> $48);
  226.  end;
  227.  
  228.  function DriveNumToQueElement (driveNum: integer): DrvQElPtr;
  229. { given a drive number, return a drive que pointer for that drive   }
  230. { 12:32 PM 3/1/90 ec }
  231.   var
  232.    aQueElement: DrvQElPtr;
  233.    headPtr: QHdrPtr;
  234.  begin
  235.   headPtr := GetDrvQHdr;              { grab the drive que header }
  236.   if headPtr <> nil then
  237.    begin
  238.     aQueElement := DrvQElPtr(headPtr^.qHead);
  239.     while (aQueElement^.dQDrive <> driveNum) and (aQueElement <> nil) do
  240.      aQueElement := DrvQElPtr(aQueElement^.qLink);
  241.     DriveNumToQueElement := aQueElement;
  242.    end
  243.   else
  244.    DriveNumToQueElement := nil;
  245.  end;
  246.  
  247.  function ValidVolumeName (volumeName: str255): str255;
  248. { a volume name must have one (and only one) colon in it, as }
  249. { the last character }
  250.  begin
  251.   if pos(':', volumeName) = 0 then
  252.    validVolumeName := concat(volumeName, ':')
  253.   else
  254.    validVolumeName := copy(volumeName, 1, pos(':', volumeName));
  255.  end;
  256.  
  257.  procedure DiskIsRemovable (paramPtr: XCmdPtr);
  258.   var
  259.    volToCheck, tempVar: str255;
  260.    PB: HParamBlockRec;
  261.    errorCode: OSErr;
  262.  begin
  263.   if AskedForHelp(paramPtr, 'DiskIsRemovable(diskName, ┬½ΓÇ£noDialog:ΓÇ¥errorGlobal┬╗)', '┬⌐ 1990 Apple Computer, Inc., v1.0 by 1990 Eric Carlson') then
  264.    exit(DiskIsRemovable);
  265.  
  266.   if paramPtr^.paramCount = 0 then
  267.    begin
  268.     ReportToUser(paramPtr, 'Disk name expected.');
  269.     exit(DiskIsRemovable);
  270.    end
  271.   else
  272.    ZeroToPas(paramPtr, paramPtr^.Params[1]^, volToCheck);
  273.   volToCheck := validVolumeName(volToCheck);{ make sure the volume name is correct }
  274.  
  275. { initialize parameter block.  Since volToCheck is a full pathname, no other field is needed}
  276.   zeroBytes(paramPtr, @PB, sizeOf(PB));
  277.   PB.ioNamePtr := @volToCheck;{ use the name passed }
  278.   PB.ioVolIndex := -1;{  and ONLY the name }
  279.   errorCode := PBHGetVInfo(@PB, false);
  280.   if errorCode <> noErr then
  281.    begin
  282.     ReportVolError(paramPtr, errorCode);
  283.     exit(DiskIsRemovable);
  284.    end;
  285.  
  286.   if DriveRemovable(DriveNumToQueElement(PB.ioVDrvInfo)) then
  287.    tempVar := 'True'
  288.   else
  289.    tempVar := 'False';
  290.  
  291.   ParamPtr^.returnValue := PasToZero(paramPtr, tempVar);
  292.  
  293.  end;{ procedure DiskIsRemovable}
  294.  
  295.  procedure MAIN (paramPtr: XCmdPtr);
  296.  begin
  297.   DiskIsRemovable(paramPtr);
  298.  end;
  299.  
  300. end.{ unit DiskIsRemovable}